;; collection/identifier.scm - (c) rohan drape, 2000-2005

;; Mechanisms for generating sequences of integer identifiers.

;; Evaluates to a procedure of no arguments that, at each successive
;; evaluation, generates the sequence of integers starting at `n'.

(define (identifierN n)
  (lambda ()
    (let ((z n))
      (set! n (+ n 1))
      z)))

;; Evaluates to a procedure of no arguments that, at each successive
;; evaluation, generates the sequence of integers starting at `left'
;; and terminating at `right'.  The next identifier in the sequence
;; after `right' is `left'.

(define (identifierC left right)
  (let ((n left))
    (lambda ()
      (let ((z n))
	(if (= n right)
	    (set! n left)
	    (set! n (+ n 1)))
	z))))

;; An identifier allocator for managing a finite pool of resources.
;; Initially all resources are available.  Resources are numbered from
;; zero to `n' minus one.  Resources are `reserved' and later
;; `released'.  If all resources are reserved, a further attempt to
;; reserve a resource will raise an error.  The implementation
;; allocates a boolean vector to hold the status of each resource.
;; The previously reserved identifier is stored and the next request
;; searches the vector in a circle starting at the identifier
;; following the one just reserved.  Status locations are '#t' if
;; available, '#f' if reserved.  There is an offset field that can be
;; used to provide IDs in a space other than zero to `n' minus one.

(define-structure identifierR (data extent index offset))

;; Create a resource identifier allocator object.

(defineV (make-identifierR n offset)
  (make-identifierR* (make-vector n #t) n -1 offset))

(define (make-identifierR/C a b)
  (make-identifierR (- b a) a))

;; Return the next identifier from `r' that is not reserved.

(define (identifierR-next r)
  (let ((s (identifierR-data r))
	(p (identifierR-index r))
	(n (identifierR-extent r)))
    (let ((next (vector-index/start+end identity s (+ p 1) n)))
      (if (not next)
	  (set! next (vector-index/start+end identity s 0 (+ p 1))))
      (if (not next)
	  (error "identifierR-next: All identifiers in use." s))
      (set-identifierR-index! r next)
      (+ next (identifierR-offset r)))))

;; Return the last identifier produced.

(define (identifierR-previous r)
  (let ((p (identifierR-index r)))
    (if (negative? p)
	(error "identifierR-previous: No identifier requested")
	(+ p (identifierR-offset r)))))

;; Return the next identifier from `r' that is not reserved and mark
;; that identifier as reserved.

(define (identifierR-reserve r)
  (let ((next (identifierR-next r))
	(s (identifierR-data r)))
    (vector-set! s (- next (identifierR-offset r)) #f)
    next))

;; Indicate that the identifier `id' that was reserved from `r' is no
;; longer in use.

(define (identifierR-release r id)
  (vector-set! (identifierR-data r) (- id (identifierR-offset r)) #t))
